home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / calendar / cal-xemacs.el.z / cal-xemacs.el
Encoding:
Text File  |  1998-05-21  |  10.1 KB  |  261 lines
  1. ;;; cal-xemacs.el --- calendar functions for menu bar and popup menu support
  2. ;;; Original file is cal-menu.el.
  3.  
  4. ;; Copyright (C) 1994 Free Software Foundation, Inc.
  5.  
  6. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
  7. ;;    Lara Rios <lrios@coewl.cen.uiuc.edu>
  8. ;; Ported to XEmacs by Chuck Thompson <cthomp@cs.uiuc.edu>
  9. ;; Keywords: calendar
  10. ;; Human-Keywords: calendar, popup menus, menu bar
  11.  
  12. ;; This file is part of XEmacs.
  13.  
  14. ;; XEmacs is free software; you can redistribute it and/or modify it
  15. ;; under the terms of the GNU General Public License as published by
  16. ;; the Free Software Foundation; either version 2, or (at your option)
  17. ;; any later version.
  18.  
  19. ;; XEmacs is distributed in the hope that it will be useful, but
  20. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22. ;; General Public License for more details.
  23.  
  24. ;; You should have received a copy of the GNU General Public License
  25. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  26. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  27.  
  28. ;;; Commentary:
  29.  
  30. ;; This collection of functions implements menu bar and popup menu support for
  31. ;; calendar.el.
  32.  
  33. ;; Comments, corrections, and improvements should be sent to
  34. ;;  Edward M. Reingold               Department of Computer Science
  35. ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
  36. ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
  37. ;;                                   Urbana, Illinois 61801
  38.  
  39. ;;; Code:
  40.  
  41. ;;(define-key calendar-mode-map 'button2 'calendar-mouse-2-date-menu)
  42. ;;(define-key calendar-mode-map 'button2up 'ignore)
  43.  
  44. (defconst calendar-popup-menu-3
  45.   '("Calendar"
  46.     ["Scroll forward" scroll-calendar-left-three-months t]
  47.     ["Scroll backward" scroll-calendar-right-three-months t]
  48.     ["Mark diary entries" mark-diary-entries t]
  49.     ["List holidays" list-calendar-holidays t]
  50.     ["Mark holidays" mark-calendar-holidays t]
  51.     ["Unmark" calendar-unmark t]
  52.     ["Lunar phases" calendar-phases-of-moon t]
  53.     ["Show diary" show-all-diary-entries t]
  54.     ["Exit calendar" exit-calendar t]
  55.     ))
  56.  
  57. (defun calendar-popup-menu-3 (e)
  58.   (interactive "@e")
  59.   (popup-menu calendar-popup-menu-3))
  60. (define-key calendar-mode-map 'button3 'calendar-popup-menu-3)
  61.  
  62. (defvar calendar-foobar nil)
  63.  
  64. (defun calendar-popup-menu-2 (e)
  65.   (interactive "@e")
  66.   (setq calendar-foobar (calendar-event-to-date e t))
  67.   (let ((menu (list (format "Menu - %s" (calendar-date-string calendar-foobar) t t)
  68.            "-----"
  69.            ["Holidays" calendar-mouse-holidays t]
  70.            ["Mark date" calendar-mouse-set-mark t]
  71.            ["Sunrise/sunset" calendar-mouse-sunrise/sunset t]
  72.            ["Other calendars" calendar-mouse-print-dates (calendar-event-to-date e)]
  73.            ["Diary entries" calendar-mouse-view-diary-entries t]
  74.            ["Insert diary entry" calendar-mouse-insert-diary-entry t]
  75.            ["Other Diary file entries"
  76.         calendar-mouse-view-other-diary-entries
  77.         (calendar-cursor-to-date)]
  78.            )))
  79.     (popup-menu menu)))
  80. (define-key calendar-mode-map 'button2 'calendar-popup-menu-2)
  81.  
  82. (defconst calendar-scroll-menu
  83.   '("Scroll"
  84.     ["Forward 1 Month" scroll-calendar-left t]
  85.     ["Forward 3 Months" scroll-calendar-left-three-months t]
  86.     ["Forward 1 Year" (scroll-calendar-left-three-months 4) t]
  87.     ["Backward 1 Month" scroll-calendar-right t]
  88.     ["Backward 3 Months" scroll-calendar-right-three-months t]
  89.     ["Backward 1 Year" (scroll-calendar-right-three-months 4) t]))
  90.  
  91. (defconst calendar-goto-menu
  92.   '("Goto"
  93.     ["Today" calendar-current-month t]
  94.     ["Beginning of week" calendar-beginning-of-week (calendar-cursor-to-date)]
  95.     ["End of week" calendar-end-of-week (calendar-cursor-to-date)]
  96.     ["Beginning of month" calendar-beginning-of-month (calendar-cursor-to-date)]
  97.     ["End of month" calendar-end-of-month (calendar-cursor-to-date)]
  98.     ["Beginning of year" calendar-beginning-of-year (calendar-cursor-to-date)]
  99.     ["End of year" calendar-end-of-year (calendar-cursor-to-date)]
  100.     ["Other date" calendar-goto-date t]
  101.     ["ISO date" calendar-goto-iso-date t]
  102.     ["Astronomical date" calendar-goto-astro-day-number t]
  103.     ["Hebrew date" calendar-goto-hebrew-date t]
  104.     ["Islamic date" calendar-goto-islamic-date t]
  105.     ["Julian date" calendar-goto-julian-date t]
  106.     ("Mayan date"
  107.      ["Next Tzolkin" calendar-next-tzolkin-date t]
  108.      ["Previous Tzolkin" calendar-previous-tzolkin-date t]
  109.      ["Next Haab" calendar-next-haab-date t]
  110.      ["Previous Haab" calendar-previous-haab-date t]
  111.      ["Next Round" calendar-next-calendar-round-date t]
  112.      ["Previous Round" calendar-previous-calendar-round-date t])
  113.     ["French date" calendar-goto-french-date t]))
  114.  
  115. (defconst calendar-holidays-menu
  116.   '("Holidays"
  117.     ["One day" calendar-cursor-holidays (calendar-cursor-to-date)]
  118.     ["3 months" list-calendar-holidays t]
  119.     ["Mark" mark-calendar-holidays t]
  120.     ["Unmark" calendar-unmark t]))
  121.  
  122. (defconst calendar-diary-menu
  123.   '("Diary"
  124.     ["Other file" view-other-diary-entries (calendar-cursor-to-date)]
  125.     ["Cursor date" view-diary-entries (calendar-cursor-to-date)]
  126.     ["Mark all" mark-diary-entries t]
  127.     ["Show all" show-all-diary-entries t]
  128.     ["Insert daily"insert-diary-entry t]
  129.     ["Insert weekly" insert-weekly-diary-entry (calendar-cursor-to-date)]
  130.     ["Insert monthly" insert-monthly-diary-entry (calendar-cursor-to-date)]
  131.     ["Insert yearly" insert-yearly-diary-entry (calendar-cursor-to-date)]
  132.     ["Insert anniversary" insert-anniversary-diary-entry (calendar-cursor-to-date)]
  133.     ["Insert block" insert-block-diary-entry (calendar-cursor-to-date)]
  134.     ["Insert cyclic" insert-cyclic-diary-entry (calendar-cursor-to-date)]
  135.     ["Insert Islamic" calendar-mouse-insert-islamic-diary-entry (calendar-cursor-to-date)]
  136.     ["Insert Hebrew" calendar-mouse-insert-hebrew-diary-entry (calendar-cursor-to-date)]))
  137.  
  138. (defun calendar-add-menus ()
  139.   (set-buffer-menubar (copy-sequence current-menubar))
  140.   (if (assoc "Calendar" current-menubar)
  141.       nil
  142.     (add-submenu nil '("Calendar"))
  143.     (if (not (assoc "Scroll" current-menubar))
  144.     (add-submenu '("Calendar") calendar-scroll-menu))
  145.     (if (not (assoc "Goto" current-menubar))
  146.     (add-submenu '("Calendar") calendar-goto-menu))
  147.     (if (not (assoc "Holidays" current-menubar))
  148.     (add-submenu '("Calendar") calendar-holidays-menu))
  149.     (if (not (assoc "Diary" current-menubar))
  150.     (add-submenu '("Calendar") calendar-diary-menu))
  151.     (if (not (assoc "Moon" current-menubar))
  152.     (add-menu-button '("Calendar") ["Moon" calendar-phases-of-moon t]))))
  153.  
  154. (defun calendar-event-to-date (event &optional error)
  155.   "Date of last event.
  156. If event is not on a specific date, signals an error if optional parameter
  157. ERROR is t, otherwise just returns nil."
  158.   (save-excursion
  159.     (goto-char (event-point event))
  160.     (calendar-cursor-to-date error)))
  161.  
  162. (defun calendar-mouse-insert-hebrew-diary-entry (event)
  163.   "Pop up menu to insert a Hebrew-date diary entry."
  164.   (interactive "e")
  165.   (let ((menu (list (format "Hebrew insert menu - %s"
  166.                 (calendar-hebrew-date-string
  167.                  (calendar-cursor-to-date)))
  168.             "-----"
  169.             ["One time" insert-hebrew-diary-entry t]
  170.             ["Monthly" insert-monthly-hebrew-diary-entry t]
  171.             ["Yearly" insert-yearly-hebrew-diary-entry t])))
  172.     (popup-menu menu)))
  173.  
  174. (defun calendar-mouse-insert-islamic-diary-entry (event)
  175.   "Pop up menu to insert an Islamic-date diary entry."
  176.   (interactive "e")
  177.   (let ((menu (list (format "Islamic insert menu - %s"
  178.                 (calendar-islamic-date-string
  179.                  (calendar-cursor-to-date)))
  180.             "-----"
  181.             ["One time" insert-islamic-diary-entry t]
  182.             ["Monthly" insert-monthly-islamic-diary-entry t]
  183.             ["Yearly" insert-yearly-islamic-diary-entry t])))
  184.     (popup-menu menu)))
  185.  
  186. (defun calendar-mouse-sunrise/sunset ()
  187.   "Show sunrise/sunset times for mouse-selected date."
  188.   (interactive)
  189.   (save-excursion
  190.     (calendar-goto-date calendar-foobar)
  191.     (setq calendar-foobar nil)
  192.     (calendar-sunrise-sunset)))
  193.  
  194. (defun calendar-mouse-holidays ()
  195.   "Show holidays for mouse-selected date."
  196.   (interactive)
  197.   (save-excursion
  198.     (calendar-goto-date calendar-foobar)
  199.     (setq calendar-foobar nil)
  200.     (calendar-cursor-holidays)))
  201.  
  202. (defun calendar-mouse-view-diary-entries ()
  203.   "View diary entries on mouse-selected date."
  204.   (interactive)
  205.   (save-excursion
  206.     (calendar-goto-date calendar-foobar)
  207.     (setq calendar-foobar nil)
  208.     (view-diary-entries 1)))
  209.  
  210. (defun calendar-mouse-view-other-diary-entries (event)
  211.   "View diary entries from alternative file on mouse-selected date."
  212.   (interactive "e")
  213.   (save-excursion
  214.     (calendar-goto-date calendar-foobar)
  215.     (call-interactively 'view-other-diary-entries)))
  216.  
  217. (defun calendar-mouse-insert-diary-entry (event)
  218.   "Insert diary entry for mouse-selected date."
  219.   (interactive "e")
  220.   (save-excursion
  221.     (calendar-goto-date calendar-foobar)
  222.     (insert-diary-entry nil)))
  223.  
  224. (defun calendar-mouse-set-mark ()
  225.   "Mark the date under the cursor."
  226.   (interactive)
  227.   (save-excursion
  228.     (calendar-goto-date calendar-foobar)
  229.     (setq calendar-foobar nil)
  230.     (calendar-set-mark nil)))
  231.  
  232. (defun calendar-mouse-print-dates ()
  233.   "Pop up menu of equivalent dates to mouse selected date."
  234.   (interactive)
  235.   (let* ((menu (list (format "Date Menu - %s (Gregorian)"
  236.                  (calendar-date-string calendar-foobar))
  237.              "-----"
  238.              (calendar-day-of-year-string calendar-foobar)
  239.              (format "ISO date: %s" (calendar-iso-date-string calendar-foobar))
  240.              (format "Julian date: %s"
  241.                  (calendar-julian-date-string calendar-foobar))
  242.              (format "Astronomical (Julian) date (before noon): %s"
  243.                  (calendar-astro-date-string calendar-foobar))
  244.              (format "Hebrew date (before sunset): %s"
  245.                  (calendar-hebrew-date-string calendar-foobar))
  246.              (let ((i (calendar-islamic-date-string calendar-foobar)))
  247.                (if (not (string-equal i ""))
  248.                (format "Islamic date (before sunset): %s" i)))
  249.              (let ((f (calendar-french-date-string calendar-foobar)))
  250.                (if (not (string-equal f ""))
  251.                (format "French Revolutionary date: %s" f)))
  252.              (format "Mayan date: %s" (calendar-mayan-date-string calendar-foobar)))))
  253.     (popup-menu menu))
  254.   (setq calendar-foobar nil))
  255.  
  256. (run-hooks 'cal-xemacs-load-hook)
  257.  
  258. (provide 'cal-xemacs)
  259.  
  260. ;;; cal-menu.el ends here
  261.